home *** CD-ROM | disk | FTP | other *** search
/ ASME's Mechanical Engine…ing Toolkit 1997 December / ASME's Mechanical Engineering Toolkit 1997 December.iso / ai / prlg195b.lzh / EXPERT.LZH / ROCKMET.PRO < prev    next >
Text File  |  1987-03-31  |  34KB  |  859 lines
  1.     
  2. /* 
  3. Note from Bob: Milt has agreed to put this small version of 
  4. "ROCKMET" in the public domain. If you're seriously interested
  5. in prospecting, contact him at the below address for the 
  6. enhanced version.
  7. */
  8.  
  9. /* THIS ROCK EXPERT SYSTEM IS BUILT BY MILT POPOVICH II AND IS
  10.        A SAMPLE COPY OF THE LARGE VERSION WHICH CAN BE PURCHASED FROM
  11.        ME AT MY ADDRESS  MILT POPOVICH II
  12.                          1355 DEWEY BLVD
  13.                          BUTTE, MONTANA 59701
  14.                          TELEPHONE (406)-494-7834
  15.     THE PURCHASE PRICE WILL BE NOMINAL FOR HOW USEFUL THE PROGRAM IS TO
  16.     ROCK HOUNDS OR PROSPECTORS  */
  17.     luster(molybdenite,metallic).
  18.     color(molybdenite,gray).
  19.     hardness(molybdenite,1-2).
  20.     streak(molybdenite,green).
  21.     fracture(molybdenite,sheets).
  22.     specific_gravity(molybdenite,4-5).
  23.     crystals(molybdenite,hexagonal).
  24.     cleavage(molybdenite,1-perfect).
  25.     test_elements(molybdenite,'MoS2').
  26.     luster(graphite,metallic).
  27.     color(graphite,gray).
  28.     color(graphite,black).
  29.     hardness(graphite,1-2).
  30.     streak(graphite,black).
  31.     fracture(graphite,sheets).
  32.     specific_gravity(graphite,1-2).
  33.     crystals(graphite,hexagonal).
  34.     cleavage(graphite,1-perfect).
  35.     test_elements(graphite,'C').
  36.     luster(sylvanite,metallic).
  37.     color(sylvanite,silver-white).
  38.     color(sylvanite,gray).
  39.     hardness(sylvanite,1-2).
  40.     streak(sylvanite,black).
  41.     fracture(sylvanite,brittle).
  42.     specific_gravity(sylvanite,7-8).
  43.     crystals(sylvanite,monoclinic).
  44.     cleavage(sylvanite,1-perfect).
  45.     test_elements(sylvanite,'AuAgTe4').
  46.     luster(bismuthinite,metallic).
  47.     color(bismuthinite,gray).
  48.     color(bismuthinite,white).
  49.     hardness(bismuthinite,1-2).
  50.     streak(bismuthinite,green).
  51.     fracture(bismuthinite,brittle).
  52.     specific_gravity(bismuthinite,6-7).
  53.     crystals(bismuthinite,orthorhombic).
  54.     cleavage(bismuthinite,1-perfect).
  55.     test_elements(bismuthinite,'Bi2S3').
  56.     luster(stibnite,metallic).
  57.     color(stibnite,gray).
  58.     hardness(stibnite,1-2).
  59.     streak(stibnite,gray).
  60.     fracture(stibnite,brittle).
  61.     specific_gravity(stibnite,4-5).
  62.     crystals(stibnite,orthorhombic).
  63.     cleavage(stibnite,1-perfect).
  64.     test_elements(stibnite,'Sb2S3').
  65.     luster(stephanite,metallic).
  66.     color(stephanite,gray).
  67.     color(stephanite,black).
  68.     hardness(stephanite,2-3).
  69.     streak(stephanite,black).
  70.     fracture(stephanite,brittle).
  71.     specific_gravity(stephanite,4-5).
  72.     crystals(stephanite,orthorhombic).
  73.     cleavage(stephanite,2-good).
  74.     test_elements(stephanite,'Ag5SbS4').
  75.     luster(argentite,metallic).
  76.     color(argentite,gray).
  77.     color(argentite,black).
  78.     hardness(argentite,2-3).
  79.     streak(argentite,black).
  80.     fracture(argentite,hackly).
  81.     specific_gravity(argentite,7-8).
  82.     crystals(argentite,isometric).
  83.     cleavage(argentite,none).
  84.     test_elements(argentite,'Ag2S').
  85.     luster(galena,metallic).
  86.     color(galena,gray).
  87.     hardness(galena,2-3).
  88.     streak(galena,gray).
  89.     fracture(galena,brittle).
  90.     specific_gravity(galena,7-8).
  91.     crystals(galena,isometric).
  92.     cleavage(galena,2-perfect).
  93.     test_elements(galena,'PbS').
  94.     luster(jamesonite,metallic).
  95.     color(jamesonite,gray).
  96.     hardness(jamesonite,2-3).
  97.     streak(jamesonite,black).
  98.     fracture(jamesonite,brittle).
  99.     specific_gravity(jamesonite,5-6).
  100.     crystals(jamesonite,monoclinic).
  101.     cleavage(jamesonite,1-good).
  102.     test_elements(jamesonite,'Pb4FeSb6S14').
  103.     luster(bournonite,metallic).
  104.     color(bournonite,gray).
  105.     color(bournonite,black).
  106.     hardness(bournonite,2-3).
  107.     streak(bournonite,gray).
  108.     streak(bournonite,black).
  109.     fracture(bournonite,brittle).
  110.     specific_gravity(bournonite,5-6).
  111.     crystals(bournonite,orthorhombic).
  112.     cleavage(bournonite,1-good).
  113.     test_elements(bournonite,'PbCuSbS3').
  114.     luster(boulangerite,metallic).
  115.     color(boulangerite,gray).
  116.     hardness(boulangerite,2-3).
  117.     streak(boulangerite,brown).
  118.     streak(boulangerite,gray).
  119.     fracture(boulangerite,brittle).
  120.     specific_gravity(boulangerite,6-7).
  121.     crystals(boulangerite,monoclinic).
  122.     cleavage(boulangerite,1-good).
  123.     test_elements(boulangerite,'Pb5Sb4S11').
  124.     luster(chalcocite,metallic).
  125.     color(chalcocite,gray).
  126.     hardness(chalcocite,2-3).
  127.     streak(chalcocite,gray).
  128.     streak(chalcocite,black).
  129.     fracture(chalcocite,brittle).
  130.     specific_gravity(chalcocite,5-6).
  131.     crystals(chalcocite,orthorhombic).
  132.     cleavage(chalcocite,1-poor).
  133.     test_element(chalcocite,'Cu2S').
  134.     luster(calaverite,metallic).
  135.     color(calaverite,yellow).
  136.     color(calaverite,white).
  137.     hardness(calaverite,2-3).
  138.     streak(calaverite,gray).
  139.     fracture(calaverite,brittle).
  140.     specific_gravity(calaverite,9-10).
  141.     crystals(calaverite,monoclinic).
  142.     cleavage(calaverite,none).
  143.     test_elements(calaverite,'AuTe2').
  144.     luster(copper,metallic).
  145.     color(copper,red).
  146.     hardness(copper,2-3).
  147.     streak(copper,red).
  148.     fracture(copper,hackly).
  149.     specific_gravity(copper,8-9).
  150.     crystals(copper,isometric).
  151.     cleavage(copper,none).
  152.     test_elements(copper,'Cu').
  153.     luster(gold,metallic).
  154.     color(gold,yellow).
  155.     hardness(gold,2-3).
  156.     streak(gold,yellow).
  157.     fracture(gold,malleable).
  158.     specific_gravity(gold,15-19).
  159.     crystals(gold,isometric).
  160.     cleavage(gold,none).
  161.     test_elements(gold,'Au').
  162.     luster(silver,metallic).
  163.     color(silver,tin-white).
  164.     hardness(silver,2-3).
  165.     streak(silver,silver).
  166.     streak(silver,gray).
  167.     fracture(silver,malleable).
  168.     specific_gravity(silver,10-11).
  169.     crystals(silver,isometric).
  170.     cleavage(silver,none).
  171.     test_elements(silver,'Ag').
  172.     luster(enargite,metallic).
  173.     color(enargite,black).
  174.     hardness(enargite,2-4).
  175.     streak(enargite,black).
  176.     fracture(enargite,brittle).
  177.     specific_gravity(enargite,4-5).
  178.     crystals(enargite,orthorhombic).
  179.     cleavage(enargite,1-perfect).
  180.     test_elements(enargite,'Cu3AsS4').
  181.     luster(bornite,metallic).
  182.     color(bornite,red).
  183.     color(bornite,blue).
  184.     hardness(bornite,2-4).
  185.     streak(bornite,black).
  186.     fracture(bornite,brittle).
  187.     specific_gravity(bornite,4-5).
  188.     crystals(bornite,isometric).
  189.     cleavage(bornite,none).
  190.     test_elements(bornite,'Cu5FeS4').
  191.     luster(millerite,metallic).
  192.     color(millerite,yellow).
  193.     hardness(millerite,3-4).
  194.     streak(millerite,black).
  195.     fracture(millerite,brittle).
  196.     specific_gravity(millerite,5-6).
  197.     crystals(millerite,hexagonal).
  198.     test_elements(millerite,'NiS').
  199.     luster(antimony,metallic).
  200.     color(antimony,tin-white).
  201.     color(antimony,gray).
  202.     hardness(antimony,3-4).
  203.     streak(antimony,white).
  204.     streak(antimony,gray).
  205.     fracture(antimony,brittle).
  206.     specific_gravity(antimony,6-7).
  207.     crystals(antimony,hexagonal).
  208.     cleavage(antimony,1-perfect).
  209.     test_elements(antimony,'Sb').
  210.     luster(tetrahedrite,metallic).
  211.     color(tetrahedrite,gray).
  212.     color(tetrahedrite,black).
  213.     hardness(tetrahedrite,3-4).
  214.     streak(tetrahedrite,gray).
  215.     fracture(tetrahedrite,brittle).
  216.     specific_gravity(tetrahedrite,4-5).
  217.     crystals(tetrahedrite,isometric).
  218.     cleavage(tetrahedrite,none).
  219.     test_elements(tetrahedrite,'Cu12Sb4S13').
  220.     luster(arsenic,metallic).
  221.     color(arsenic,tin-white).
  222.     hardness(arsenic,3-4).
  223.     streak(arsenic,white).
  224.     fracture(arsenic,brittle).
  225.     specific_gravity(arsenic,5-6).
  226.     crystals(arsenic,hexagonal).
  227.     cleavage(arsenic,1-perfect).
  228.     test_elements(arsenic,'As').
  229.     luster(chalcopyrite,metallic).
  230.     color(chalcopyrite,yellow).
  231.     hardness(chalcopyrite,3-4).
  232.     streak(chalcopyrite,black).
  233.     fracture(chalcopyrite,brittle).
  234.     specific_gravity(chalcopyrite,4-5).
  235.     crystals(chalcopyrite,tetragonal).
  236.     cleavage(chalcopyrite,1-poor).
  237.     test_elements(chalcopyrite,'CuFeS2').
  238.     luster(pentlandite,metallic).
  239.     color(pentlandite,yellow).
  240.     hardness(pentlandite,3-4).
  241.     streak(pentlandite,brown).
  242.     fracture(pentlandite,brittle).
  243.     specific_gravity(pentlandite,4-3).
  244.     crystals(pentlandite,isometric).
  245.     cleavage(pentlandite,none).
  246.     test_elements(pentlandite,'FeNi_9S8').
  247.     luster(pyrrhotite,metallic).
  248.     color(pyrrhotite,bronze).
  249.     hardness(pyrrhotite,3-5).
  250.     streak(pyrrhotite,black).
  251.     fracture(pyrrhotite,brittle).
  252.     specific_gravity(pyrrhotite,4-5).
  253.     crystals(pyrrhotite,orthorhombic).
  254.     cleavage(pyrrhotite,none).
  255.     test_elements(pyrrhotite,'Fe1-xS').
  256.     luster(platinum,metallic).
  257.     color(platinum,tin-white).
  258.     hardness(platinum,4-5).
  259.     streak(platinum,gray).
  260.     fracture(platinum,malleable).
  261.     specific_gravity(platinum,14-19).
  262.     crystals(platinum,isometric).
  263.     cleavage(platinum,none).
  264.     test_elements(platinum,'Pt').
  265.     luster(limonite,metallic).
  266.     color(limonite,yellow).
  267.     hardness(limonite,4-6).
  268.     streak(limonite,brown).
  269.     fracture(limonite,earthy).
  270.     specific_gravity(limonite,2-4).
  271.     crystals(limonite,amorphous).
  272.     cleavage(limonite,none).
  273.     test_elements(limonite,'FeO_OHnH2O').
  274.     luster(goethite,metallic).
  275.     color(goethite,yellow).
  276.     hardness(goethite,5-6).
  277.     streak(goethite,yellow).
  278.     fracture(goethite,splintery).
  279.     specific_gravity(goethite,3-4).
  280.     crystals(goethite,orthorhombic).
  281.     cleavage(goethite,1-perfect).
  282.     test_elements(goethite,'HFeO2').
  283.     luster(nickeline,metallic).
  284.     color(nickeline,red).
  285.     hardness(nickeline,5-6).
  286.     streak(nickeline,black).
  287.     fracture(nickeline,uneven).
  288.     specific_gravity(nickeline,7-8).
  289.     crystals(nickeline,hexagonal).
  290.     cleavage(nickeline,none).
  291.     test_elements(nickeline,'NiAS').
  292.     luster(hematite,metallic).
  293.     color(hematite,gray).
  294.     color(hematite,brown).
  295.     color(hematite,black).
  296.     color(hematite,red).
  297.     hardness(hematite,5-6).
  298.     streak(hematite,red).
  299.     fracture(hematite,brittle).
  300.     specific_gravity(hematite,4-5).
  301.     crystals(hematite,hexagonal).
  302.     cleavage(hematite,none).
  303.     test_elements(hematite,'Fe2O3').
  304.     luster(ilmenite,metallic).
  305.     color(ilmenite,black).
  306.     hardness(ilmenite,5-6).
  307.     streak(ilmenite,black).
  308.     fracture(ilmenite,brittle).
  309.     specific_gravity(ilmenite,4-5).
  310.     crystals(ilmenite,hexagonal).
  311.     cleavage(ilmenite,none).
  312.     test_elements(ilmenite,'FeTiO3').
  313.     luster(cobaltite,metallic).
  314.     color(cobaltite,silver-white).
  315.     color(cobaltite,gray).
  316.     hardness(cobaltite,5-6).
  317.     streak(cobaltite,black).
  318.     fracture(cobaltite,brittle).
  319.     specific_gravity(cobaltite,5-6).
  320.     crystals(cobaltite,isometic).
  321.     cleavage(cobaltite,1-perfect).
  322.     test_elements(cobaltite,'CoFe_AsS').
  323.     luster(chromite,metallic).
  324.     color(chromite,black).
  325.     hardness(chromite,5-6).
  326.     streak(chromite,brown).
  327.     fracture(chromite,brittle).
  328.     specific_gravity(chromite,4-5).
  329.     crystals(chromite,isometric).
  330.     cleavage(chromite,none).
  331.     test_elements(chromite,'FeCr2O4').
  332.     luster(skutterudite,metallic).
  333.     color(skutterudite,tin-white).
  334.     color(skutterudite,gray).
  335.     hardness(skutterudite,5-6).
  336.     streak(skutterudite,gray).
  337.     fracture(skutterudite,brittle).
  338.     specific_gravity(skutterudite,6-7).
  339.     crystals(skutterudite,isometric).
  340.     cleavage(skutterudite,2-good).
  341.     test_elements(skutterudite,'CoNi_As3').
  342.     luster(arsenopyrite,metallic).
  343.     color(arsenopyrite,gray).
  344.     hardness(arsenopyrite,5-6).
  345.     streak(arsenopyrite,black).
  346.     fracture(arsenopyrite,brittle).
  347.     specific_gravity(arsenopyrite,6-7).
  348.     crystals(arsenopyrite,monoclinic).
  349.     cleavage(arsenopyrite,1-good).
  350.     test_elements(arsenopyrite,'FeAsS').
  351.     luster(franklinite,metallic).
  352.     color(franklinite,black).
  353.     hardness(franklinite,5-7).
  354.     streak(franklinite,black).
  355.     fracture(franklinite,brittle).
  356.     specfic_gravity(franklinite,5-6).
  357.     crystals(franklinite,isometric).
  358.     cleavage(franklinite,none).
  359.     test_elements(franklinite,'ZnMnFe_FeMn_2O4').
  360.     luster(magnetite,metallic).
  361.     color(magnetite,black).
  362.     hardness(magnetite,5-7).
  363.     streak(magnetite,black).
  364.     fracture(magnetite,brittle).
  365.     specific_gravity(magnetite,4-5).
  366.     crystals(magnetite,isometric).
  367.     cleavage(magnetite,none).
  368.     test_elements(magnetite,'Fe3O4').
  369.     luster(pyrolusite,metallic).
  370.     color(pyrolusite,black).
  371.     color(pyrolusite,gray).
  372.     hardness(pyrolusite,6-7).
  373.     streak(pyrolusite,black).
  374.     fracture(pyrolusite,brittle).
  375.     specific_gravity(pyrolusite,4-5).
  376.     crystals(pyrolusite,tetragonal).
  377.     cleavage(pyrolusite,1-perfect).
  378.     test_elements(pyrolusite,'MnO2').
  379.     luster(rutile,metallic).
  380.     color(rutile,red).
  381.     color(rutile,brown).
  382.     color(rutile,black).
  383.     hardness(rutile,6-7).
  384.     streak(rutile,white).
  385.     fracture(rutile,brittle).
  386.     specific_gravity(rutile,4-5).
  387.     crystals(rutile,tetragonal).
  388.     cleavage(rutile,2-good).
  389.     test_elements(rutile,'TiO2').
  390.     luster(marcasite,metallic).
  391.     color(marcasite,yellow).
  392.     hardness(marcasite,6-7).
  393.     streak(marcasite,brown).
  394.     fracture(marcasite,brittle).
  395.     specific_gravity(marcasite,4-5).
  396.     crystals(marcasite,orthorhombic).
  397.     cleavage(marcasite,2-good).
  398.     test_elements(marcasite,'FeS2').
  399.     luster(bixbyite,metallic).
  400.     color(bixbyite,black).
  401.     hardness(bixbyite,6-7).
  402.     streak(bixbyite,black).
  403.     fracture(bixbyite,brittle).
  404.     specific_gravity(bixbyite,4-5).
  405.     crystals(bixbyite,isometric).
  406.     cleavage(bixbyite,1-poor).
  407.     test_elements(bixbyite,'MnFe_2O3').
  408.     luster(pyrite,metallic).
  409.     color(pyrite,yellow).
  410.     hardness(pyrite,6-7).
  411.     streak(pyrite,black).
  412.     fracture(pyrite,brittle).
  413.     specific_gravity(pyrite,4-5).
  414.     crystals(pyrite,isometric).
  415.     cleavage(pyrite,none).
  416.     test_elements(pyrite,'FeS2').
  417.     /*     end of facts marker        */
  418.     luster(end,' ').
  419.     color(end,' ').
  420.     hardness(end,' ').
  421.     streak(end,' ').
  422.     fracture(end,' ').
  423.     specific_gravity(end,' ').
  424.     crystals(end,' ').
  425.     cleavage(end,' ').
  426.     test_elements(T,' ').
  427.     /*        graphics rules              */
  428.     clearline:- Buffer= '                       ',
  429.                print('                              ',Buffer).
  430.     sleep(N,1):-N =<1.
  431.     sleep(N,R):- not(N=<1),N1 is N-1,sleep(N1,R1),R is N+R1.
  432.  
  433.     ll:-drawchar(42,3).
  434.     sp:-drawchar(95,4).
  435.     pp:-drawchar(124,2).
  436.     cc(Row,Column,Page):-curset(Row,Column,Page).
  437.  
  438.     top(X1,J1,Stop1):- C is J1 + 1,C =< Stop1,cc(X1,C,0),sp,
  439.              top(X1,C,Stop1).
  440.     leftside(X2,J2,Stop2):-
  441.       R is X2 + 1,R =<Stop2,cc(R,J2,0),pp,leftside(R,J2,Stop2).
  442.     bottom(X3,J3,Stop3):- C is J3 + 1,C =< Stop3,cc(X3,C,0),sp,
  443.                 bottom(X3,C,Stop3).
  444.     rightside(X4,J4,Stop4):-
  445.        R is X4 + 1,R =<Stop4,cc(R,J4,0),pp,rightside(R,J4,Stop4).
  446.  
  447.     box(X1,Y1,Stop1,X2,Y2,Stop2,X3,Y3,Stop3,X4,Y4,Stop4):-
  448.          not(top(X1,Y1,Stop1)),
  449.          not(leftside(X2,Y2,Stop2)),not(bottom(X3,Y3,Stop3)),
  450.          not(rightside(X4,Y4,Stop4)).
  451.     r:-
  452.     cls,cc(1,22,0),ll,cc(2,22,0),
  453.     ll,cc(3,22,0),ll,cc(4,22,0),
  454.     ll,cc(5,22,0),ll,cc(6,22,0),
  455.     ll,cc(7,22,0),ll,cc(8,22,0),
  456.     ll,cc(1,23,0),ll,cc(1,24,0),
  457.     ll,cc(1,25,0),ll,cc(1,26,0),
  458.     ll,cc(2,26,0),ll,cc(3,26,0),
  459.     ll,cc(4,26,0),ll,cc(4,23,0),
  460.     ll,cc(4,23,0),ll,cc(4,24,0),
  461.     ll,cc(4,25,0),ll,cc(4,26,0),
  462.     ll,cc(5,24,0),ll,cc(6,25,0),
  463.     ll,cc(7,26,0),ll,cc(8,26,0),
  464.     ll.
  465.     o:- cc(3,29,0),ll,cc(3,30,0),
  466.     ll,cc(3,31,0),ll,cc(3,32,0),
  467.     ll,cc(3,33,0),ll,cc(3,34,0),
  468.     ll,cc(4,29,0),ll,cc(5,29,0),
  469.     ll,cc(6,29,0),ll,cc(7,29,0),
  470.     ll,cc(8,29,0),ll,cc(8,30,0),
  471.     ll,cc(8,31,0),ll,cc(8,32,0),
  472.     ll,cc(8,33,0),ll,cc(8,34,0),
  473.     ll,cc(4,34,0),ll,cc(5,34,0),
  474.     ll,cc(6,34,0),ll,cc(7,34,0),
  475.     ll.
  476.     c:- cc(3,37,0),ll,cc(3,38,0),
  477.     ll,cc(3,39,0),ll,cc(3,40,0),
  478.     ll,cc(3,41,0),ll,cc(4,37,0),
  479.     ll,cc(4,41,0),ll,cc(5,37,0),
  480.     ll,cc(6,37,0),ll,cc(7,37,0),
  481.     ll,cc(7,41,0),ll,
  482.     cc(8,37,0),ll,cc(8,38,0),
  483.     ll,cc(8,39,0),ll,cc(8,40,0),
  484.     ll,cc(8,41,0),ll.
  485.     k:-cc(1,44,0),ll,cc(1,48,0),
  486.     ll,cc(2,44,0),ll,
  487.     cc(2,47,0),ll,cc(3,44,0),
  488.     ll,cc(3,46,0),ll,
  489.     cc(4,44,0),ll,cc(4,45,0),
  490.     ll,
  491.     cc(5,44,0),ll,cc(5,46,0),
  492.     ll,cc(6,44,0),ll,
  493.     cc(6,46,0),ll,cc(7,44,0),
  494.     ll,cc(7,47,0),ll,
  495.     cc(8,44,0),ll,cc(8,48,0),ll.
  496.     e:-
  497.     cc(12,22,0),ll,cc(12,23,0),
  498.     ll,cc(12,24,0),ll,cc(12,25,0),
  499.     ll,cc(12,26,0),ll,cc(13,22,0),
  500.     ll,cc(14,22,0),ll,cc(15,22,0),
  501.     ll,cc(15,23,0),ll,cc(15,24,0),
  502.     ll,cc(15,25,0),ll,cc(15,26,0),
  503.     ll,cc(16,22,0),ll,cc(17,22,0),
  504.     ll,cc(18,22,0),ll,cc(19,22,0),
  505.     ll,cc(19,23,0),ll,cc(19,24,0),
  506.     ll,cc(19,25,0),ll,cc(19,26,0),ll.
  507.     x:-
  508.     cc(12,29,0),ll,cc(13,30,0),
  509.     ll,cc(14,31,0),ll,cc(15,31,0),
  510.     ll,cc(16,31,0),ll,cc(17,30,0),
  511.     ll,cc(18,30,0),ll,cc(19,29,0),
  512.     ll,cc(12,34,0),ll,cc(13,33,0),
  513.     ll,cc(14,32,0),ll,cc(15,32,0),
  514.     ll,cc(16,32,0),ll,cc(17,33,0),
  515.     ll,cc(18,33,0),ll,cc(19,34,0),
  516.     ll.
  517.     p:-
  518.     cc(12,37,0),ll,cc(12,38,0),
  519.     ll,cc(12,39,0),ll,cc(12,40,0),
  520.     ll,cc(12,41,0),ll,cc(13,37,0),
  521.     ll,cc(13,41,0),ll,cc(14,37,0),ll,cc(14,41,0),ll,cc(15,37,0),
  522.     ll,cc(15,38,0),ll,cc(15,39,0),
  523.     ll,cc(15,40,0),ll,cc(15,41,0),
  524.     ll,cc(16,37,0),ll,cc(17,37,0),
  525.     ll,cc(18,37,0),ll,cc(19,37,0),ll.
  526.     e1:-
  527.     cc(12,44,0),ll,cc(12,45,0),
  528.     ll,cc(12,46,0),ll,cc(12,47,0),
  529.     ll,cc(12,48,0),ll,cc(13,44,0),
  530.     ll,cc(14,44,0),ll,cc(15,44,0),
  531.     ll,cc(15,45,0),ll,cc(15,46,0),
  532.     ll,cc(15,47,0),ll,cc(15,48,0),
  533.     ll,cc(16,44,0),ll,cc(17,44,0),
  534.     ll,cc(18,44,0),ll,cc(19,44,0),
  535.     ll,cc(19,45,0),ll,cc(19,46,0),
  536.     ll,cc(19,47,0),ll,cc(19,48,0),ll.
  537.     r1:-
  538.     cc(12,51,0),ll,cc(13,51,0),
  539.     ll,cc(14,51,0),ll,cc(15,51,0),
  540.     ll,cc(16,51,0),ll,cc(17,51,0),
  541.     ll,cc(18,51,0),ll,cc(19,51,0),
  542.     ll,cc(12,52,0),ll,cc(12,53,0),
  543.     ll,cc(12,54,0),ll,cc(12,55,0),
  544.     ll,cc(13,55,0),ll,cc(14,55,0),
  545.     ll,cc(15,55,0),ll,cc(15,52,0),
  546.     ll,cc(15,53,0),ll,cc(15,54,0),
  547.     ll,cc(16,53,0),ll,cc(17,54,0),
  548.     ll,cc(18,55,0),ll,cc(19,55,0),ll.
  549.     t:-
  550.     cc(12,58,0),ll,cc(12,59,0),
  551.     ll,cc(12,60,0),ll,cc(12,61,0),
  552.     ll,cc(12,62,0),ll,cc(12,63,0),
  553.     ll,cc(13,60,0),ll,cc(13,61,0),
  554.     ll,cc(14,60,0),ll,cc(14,61,0),
  555.     ll,cc(15,60,0),ll,cc(15,61,0),
  556.     ll,cc(16,60,0),ll,cc(16,61,0),
  557.     ll,cc(17,60,0),ll,cc(17,61,0),
  558.     ll,cc(18,60,0),ll,cc(18,61,0),
  559.     ll,cc(19,60,0),ll,cc(19,61,0),ll.
  560.     d1:-box(0,0,79,0,1,24,24,1,79,0,79,24).
  561.     d2:-box(2,3,77,2,4,22,22,4,77,2,77,22).
  562.     d3:-box(4,7,75,4,8,20,20,8,75,4,75,20).
  563.     d4:-box(6,9,73,6,10,18,18,10,73,6,73,18).
  564.  
  565.     draw:- r,o,c,k,e,x,p,e1,r1,t,
  566.           cc(22,38,0),print('Copyright l987 Milt Popovich II'),
  567.           box(0,9,70,0,10,23,23,9,70,0,70,23).
  568.     drawboxes :- d1,d2,d3,d4.
  569.     case(g1):- cls,drawboxes,rock_three,
  570.                prtscr,sleep(50,R),start.
  571.     case(g2):- cls,drawboxes,rock,prtscr,sleep(50,R),start.
  572.     case(a):- cls,drawboxes,add,prtscr,sleep(50,R),start.
  573.     case(c):- cls,drawboxes,rock_characteristics,prtscr,sleep(50,R),start.
  574.     case(h):- cls,list,prtscr,sleep(50,Nu),start.
  575.     case(d):- cls,drawboxes,dump,prtscr,sleep(50,Nu),start.
  576.     case(e):- cls,exitsys.
  577.     case(Unknown):-cc(17,25,0), print('Not a valid command try again '),
  578.     cc(16,25,0),
  579.     print('ENTER SELECTION HERE '),read(Command),case(Command).
  580.  
  581.     start:- cls,draw,sleep(25,R),prtscr,cls,drawboxes,cc(1,24,0),
  582.          print('MAIN MENU FOR ROCK EXPERT SYSTEM'),cc(7,22,0),
  583.          print('Select one of the following Commands: '),
  584.     cc(8,22,0),print('YOU WANT TO ME TO GUESS KNOWING 3 ITEMS TYPE g1'),
  585.     cc(9,22,0),print('YOU WANT ME TO GUESS KNOWING 7 ITEMS TYPE g2'),
  586.     cc(10,22,0),print('YOU KNOW THE MINERAL CHARACTERISTICS TYPE c'),
  587.     cc(11,22,0),print('YOU WANT TO ADD A ROCK MINERAL TYPE a'),
  588.     cc(12,22,0),print('YOU WANT TO SEE VALID ITEMS TO TYPE TYPE h'),
  589.     cc(13,22,0),print('YOU WANT TO SEE MY KNOWLEDGE BASE TYPE d'),
  590.     cc(14,22,0),print('YOU WANT TO EXIT THE ROCK EXPERT TYPE e'),
  591.     cc(16,25,0),
  592.       print('ENTER SELECTION HERE '),
  593.       read(Command),case(Command),prtscr.
  594.     /*        end of graphics rules        */
  595.  
  596.     /*        rules for expert system    */
  597.     append([],L,L):-!.
  598.     append([X|L1],L2,[X|L3]):- append(L1,L2,L3).
  599.     mymember(X,[X|_]):-!.
  600.     mymember(X,[_|Y]):-mymember(X,Y).
  601.     valid_minerals([molybdenite,graphite,sylvanite,bismuthinite,stibnite,
  602.     stephanite,argentite,galena,jamesonite,bournonite,
  603.     boulangerite,chalcocite,calaverite,copper,gold,silver,
  604.     enargite,bornite,millerite,antimony,tetrahedrite,
  605.     arsenic,chalcopyrite,pentlandite,pyrrhotite,platinum,
  606.     limonite,goethite,nickleine,hematite,ilmenite,
  607.     cobaltite,chromite,skutterudite,arsenopyrite,franklinite,
  608.     magnetite,pyrolusite,rutile,marcasite,bixbyite,
  609.     pyrite,biotite,siderite,wolframite,augite,hornblende,
  610.     sphalerite,uraninite,cassiterite,calcite,garnet,
  611.     serpentine,pyrargyrite,prousite,realgar,cinnabar,bauxite,
  612.     cuprite,gypsum,rhodochrosite,fluorite,quartz,azurite,
  613.     malachite,chrysocolla,talc,smithsonite,barite,olivine,
  614.     beryl,orpiment,scheelite,muscovite,zircon,corundum,
  615.     lazurite,anglesite,magnesite]).
  616.  
  617.     valid_luster([metallic,nonmetallic]).
  618.  
  619.     valid_color([gray,silver-white,white,black,yellow,red,tin-white,
  620.     blue,bronze,brown,all_colors,green,vermillion,colorless,
  621.     pink,violet,azure_blue,purple,orange,transparent]).
  622.  
  623.     valid_hardness([1-2,2-3,2-4,3-4,3-5,4-5,4-6,5-6,5-7,6-7,1-3,8-9,
  624.     2-3,7-8]).
  625.     valid_streak([green,black,gray,brown,red,yellow,silver,white,
  626.     colorless,blue]).
  627.  
  628.     valid_fracture([sheets,brittle,hackly,malleable,earthy,splintery,
  629.     uneven,tough,conchoidal,sectile]).
  630.  
  631.     valid_gravity([4-5,1-2,7-8,6-7,4-5,5-6,9-10,8-9,15-19,10-11,
  632.     14-19,2-4,3-4,2-3,6-10]).
  633.     valid_crystals([hexagonal,monoclinic,orthorhombic,isometric,
  634.     tetragonal,amorphous,massive]).
  635.     valid_cleavage([1-perfect,2-good,none,3-perfect,1-good,1-poor,
  636.     2-perfect,6-perfect,good,poor,4-perfect,2-poor,
  637.     6-poor]).
  638.     mineral_search(G,[A1,B1,C1,D1,E1,F1,G1,H1]):-
  639.                    luster(G,A1),color(G,B1),
  640.                    hardness(G,C1),streak(G,D1),
  641.                    fracture(G,E1),specific_gravity(G,F1),
  642.                    crystals(G,G1),cleavage(G,H1).
  643.  
  644.     mineral_search_three(G,[A1,B1,C1]):- luster(G,A1),color(G,B1),
  645.                                          hardness(G,C1).
  646.  
  647.  
  648.     check_dump(X):- not(X=end).
  649.     check_dump(X):- X = end,cls,curset(12,20,0),
  650.     print('I m done dumping'),start.
  651.     check_guess(G,Rockmineral):- not(G = end).
  652.     check_guess(G,Rockmineral):- G = end,
  653.     Rockmineral = 'I can not think of any more minerals',
  654.     curset(16,20,0),
  655.     clearline,curset(16,20,0),
  656.     print(Rockmineral),curset(17,20,0),
  657.     clearline,sleep(30,R),start.
  658.  
  659.     compare([A|B],[A1|B1],G,Rockmineral):-
  660.            check_guess(G,Rockmineral),([A|B] = [A1|B1]),Rockmineral=G.
  661.  
  662.     unknown_mineral([W|V],Rockmineral):-
  663.              mineral_search(Guess,[X|Z]),
  664.              compare([W|V],[X|Z],Guess,Rockmineral).
  665.  
  666.     unknown_mineral_three([W|V],Rockmineral):-
  667.              mineral_search_three(Guess,[X|Z]),
  668.              compare([W|V],[X|Z],Guess,Rockmineral).
  669.  
  670.     choice(y):- curset(16,20,0),clearline,!,fail.
  671.     choice(n):- start.
  672.     choice(Unknown):-
  673.     curset(17,20,0),
  674.     print('Do you want another guess type y or n --> '),
  675.     read(Answer),choice(Answer).
  676.  
  677.     /*                  check rules                 */
  678.     check_mineral(M,L):-valid_minerals(Z),not(mymember(M,Z)),
  679.      cc(7,20,0),clearline,cc(7,20,0),
  680.      print('Enter the name of the mineral '),
  681.      read(Mineral1),check_mineral(Mineral1,Mineral).
  682.     check_mineral(M,L):- M=L.
  683.     check_luster(M,L):- valid_luster(Z),not(mymember(M,Z)),
  684.           curset(8,20,0),clearline,
  685.     curset(8,20,0),print('Enter in the luster of your rock --> '),
  686.     read(Luster),Luster=L,check_luster(L,L1).
  687.     check_luster(M,L):- M=L.
  688.     check_color(M,L):- valid_color(Z),not(mymember(M,Z)),
  689.     curset(9,20,0),clearline,
  690.     curset(9,20,0),print('Enter in the color of your rock --> '),
  691.     read(Color),Color=L,check_color(L,L1).
  692.     check_color(M,L):- M=L.
  693.     check_hardness(M,L):- valid_hardness(Z),not(mymember(M,Z)),
  694.     curset(10,20,0),clearline,
  695.     curset(10,20,0),print('Enter in the hardness of your rock --> '),
  696.     read(Hardness),Hardness=L,check_hardness(L,L1).
  697.     check_hardness(M,L):- M=L.
  698.     check_streak(M,L):-
  699.     valid_streak(Z),not(mymember(M,Z)),curset(11,20,0),clearline,
  700.     curset(11,20,0),print('Enter in the streak of your rock --> '),
  701.     read(Streak),Streak=L,check_streak(L,L1).
  702.     check_streak(M,L):- M=L.
  703.     check_fracture(M,L):- valid_fracture(Z),not(mymember(M,Z)),
  704.     curset(12,20,0),clearline,
  705.     curset(12,20,0),print('Enter in the fracture of your rock --> '),
  706.     read(Fracture),Fracture=L,check_fracture(L,L1).
  707.     check_fracture(M,L):- M=L.
  708.     check_gravity(M,L):- valid_gravity(Z),not(mymember(M,Z)),
  709.     curset(13,20,0),clearline,
  710.     curset(13,20,0),print('Enter in the specific_gravity of your rock -->'
  711.     ),read(Specific_gravity),Specific_gravity=L,check_gravity(L,L1).
  712.     check_gravity(M,L):-M=L.
  713.     check_crystals(M,L):- valid_crystals(Z),not(mymember(M,Z)),
  714.     curset(14,20,0),clearline,
  715.     curset(14,20,0),print('Enter in the crystals of your rock --> '),
  716.     read(Crystals),Crystals=L,check_crystals(L,L1).
  717.     check_crystals(M,L):- M=L.
  718.     check_cleavage(M,L):- valid_cleavage(Z),not(mymember(M,Z)),
  719.     curset(15,20,0),clearline,
  720.     curset(15,20,0),print('Enter in the cleavages of your rock --> '),
  721.     read(Cleavage),Cleavage=L,check_cleavage(L,L1).
  722.     check_cleavage(M,L):- M=L.
  723.     /*                end of check rules                  */
  724.     /*                the knowledge rules                 */
  725.     rock:- curset(1,20,0),
  726.            print('THE GUESS MENU FOR 7 CHARACTERISTICS'),
  727.            curset(8,20,0),print('Enter in the Luster of your rock
  728.     --> '),read(Luster1),check_luster(Luster1,Luster),curset(9,20,0),
  729.      print('Enter in the color of your rock --> '),read(Color1),
  730.     check_color(Color1,Color),curset(10,20,0),
  731.     print('Enter in the hardness of your rock --> '),read(Hardness1),
  732.     check_hardness(Hardness1,Hardness),curset(11,20,0),
  733.      print('Enter in the streak if your rock --> '),read(Streak1),
  734.     check_streak(Streak1,Streak),curset(12,20,0),
  735.      print('Enter in the fracture of your rock --> '),read(Fracture1),
  736.     check_fracture(Fracture1,Fracture),curset(13,20,0),
  737.      print('Enter in the specific_gravity of your rock --> '),
  738.      read(Specific_gravity1),
  739.      check_gravity(Specific_gravity1,Specific_gravity),curset(14,20,0),
  740.      print('Enter in the crystals of your rock --> '),read(Crystals1),
  741.     check_crystals(Crystals1,Crystals),curset(15,20,0),
  742.      print('Enter in the cleavage of your rock -->'),
  743.     read(Cleavage1),check_cleavage(Cleavage1,Cleavage),
  744.     unknown_mineral([Luster,Color,Hardness,Streak,Fracture,
  745.     Specific_gravity,Crystals,Cleavage],Search),curset(16,20,0),
  746.     print('The rock mineral is ',Search),curset(17,20,0),
  747.     print('Do you want another guess type y or n --> '),read(Answer),
  748.     choice(Answer).
  749.  
  750.     rock_three:-curset(1,20,0),
  751.          print('THE GUESS MENU FOR 3 CHARACTERISTICS'),
  752.          curset(8,20,0),
  753.          print('Enter in the Luster of your rock --> '),
  754.          read(Luster1),check_luster(Luster1,Luster),curset(9,20,0),
  755.      print('Enter in the color of your rock --> '),read(Color1),
  756.      check_color(Color1,Color),curset(10,20,0),
  757.     print('Enter in the hardness of your rock --> '),read(Hardness1),
  758.     check_hardness(Hardness1,Hardness),
  759.     unknown_mineral_three([Luster,Color,Hardness],Search_three),
  760.     curset(16,20,0),
  761.     print('The rock mineral is ',Search_three),curset(17,20,0),
  762.     print('Do you want another guess type y or n --> '),read(Answer),
  763.     choice(Answer).
  764.     add_to_the_mineral(X):-  valid_minerals([H|T]),append([H|T],[X],Z),
  765.           retract(valid_minerals(L)),asserta(valid_minerals(Z)).
  766.     list:- curset(1,20,0),
  767.           print('THE MENU FOR A LISTING VALID CHARACTERISTICS'),
  768.            curset(2,1,0),valid_minerals(Z),
  769.           print('We have the following minerals   ',Z),
  770.           print('****************************'),nl,
  771.           valid_luster(A),print('We have the following luster :',A),
  772.           print('****************************'),nl,
  773.           valid_color(B),print('We have the following colors  :',B),
  774.           print('****************************'),nl,
  775.           valid_hardness(C),print('We have the following hardness
  776.     intervals :',C),print('**************************'),nl,
  777.           valid_streak(D),print('We have the following streaks :',D),
  778.           print('****************************'),nl,valid_fracture(E),
  779.          print('We have the following fractures :',E),
  780.          print('*****************************'),nl,valid_gravity(F),
  781.          print('We have the following specific gravities :',F),
  782.          print('*****************************'),nl,valid_crystals(G),
  783.          print('We have the following crystals :',G),
  784.          print('*****************************'),nl,valid_cleavage(H),
  785.          print('We have the following cleavages :',H).
  786.     add:- curset(1,20,0),print('THE MENU FOR ADDING MINERALS'),
  787.           curset(8,20,0),
  788.           print('Please enter the name of the mineral--> '),read(X),
  789.           add_to_the_mineral(X),
  790.           curset(9,20,0),
  791.           print('Enter the luster of your mineral --> '),read(A),
  792.           asserta(luster(X,A)),curset(10,20,0),
  793.           print('Enter the color of ',X,' --> '),read(B),
  794.           asserta(color(X,B)),curset(11,20,0),
  795.           print('Enter the hardness interval of ',X,' --> '),read(C),
  796.           asserta(hardness(X,C)),curset(12,20,0),
  797.           print('Enter the streak of ',X,' --> '),read(D),
  798.           asserta(streak(X,D)),curset(13,20,0),
  799.           print('Enter the fracture of ',X,' --> '),read(E),
  800.           asserta(fracture(X,E)),curset(14,20,0),
  801.           print('Enter the specific_gravity interval of ',X,' --> '),
  802.                 read(F),
  803.           asserta(specific_gravity(X,F)),curset(15,20,0),
  804.           print('Enter the crystals of ',X,' --> '),read(G),
  805.           asserta(crystals(X,G)),curset(16,20,0),
  806.           print('Enter the cleavage of ',X,' --> '),read(H),
  807.           asserta(cleavage(X,H)),curset(17,20,0),
  808.           print('Enter the test elements of ',X,' with quotes-> '),
  809.           read(I),asserta(test_elements(X,I)).
  810.     dump :- curset(1,20,0),print('THE DUMP OF MINERALS'),
  811.             curset(3,20,0),
  812.             print('IF YOU WANT TO STOP THIS PUSH ESC KEY AND TYPE start'),
  813.             luster(X,A),check_dump(X),
  814.                curset(8,20,0),clearline,curset(8,20,0),
  815.                 print(X,' has a ',A,' luster '),
  816.                 color(X,B),curset(9,20,0),clearline,curset(9,20,0),
  817.                  print(X,' has the color of ',B),
  818.                 hardness(X,C),curset(10,20,0),clearline,curset(10,20,0),
  819.                 print(X,' is in the hardness interval ',C),
  820.                 streak(X,D),curset(11,20,0),clearline,curset(11,20,0),
  821.                 print(X,' has a streak color of ',D),
  822.                 fracture(X,E),curset(12,20,0),clearline,curset(12,20,0),
  823.                 print(X,' has a fracture of ',E),
  824.                 specific_gravity(X,F),curset(13,20,0),
  825.                 clearline,curset(13,20,0),
  826.                 print(X,' has a specific gravity of ',F),
  827.                 crystals(X,G),curset(14,20,0),clearline,curset(14,20,0),
  828.                 print(X,' has a crystal  ',G,' structure '),
  829.                 cleavage(X,H),curset(15,20,0),clearline,curset(15,20,0),
  830.                 print(X,' has a cleavage of ',H),
  831.             test_elements(X,I),curset(16,20,0),clearline,curset(16,20,0),
  832.                 print(X,' chemical elements are ',I),
  833.                 prtscr,sleep(10,Nu),fail.
  834.  
  835.     mineral(X):- curset(8,20,0),luster(X,A),
  836.                 print(X,' has a ',A,' luster '),
  837.                 color(X,B),curset(9,20,0),
  838.                 print(X,' has the color of ',B),
  839.                 hardness(X,C),curset(10,20,0),
  840.                 print(X,' is in the hardness interval ',C),
  841.                 streak(X,D),curset(11,20,0),
  842.                 print(X,' has a streak color of ',D),
  843.                 fracture(X,E),curset(12,20,0),
  844.                 print(X,' has a fracture of ',E),
  845.                 specific_gravity(X,F),curset(13,20,0),
  846.                 print(X,' has a specific gravity of ',F),
  847.                 crystals(X,G),curset(14,20,0),
  848.                 print(X,' has a crystal  ',G,' structure '),
  849.                 cleavage(X,H),curset(15,20,0),
  850.                 print(X,' has a cleavage of ',H),
  851.                 test_elements(X,I),curset(16,20,0),
  852.                 print(X,' chemical elements are ',I).
  853.  
  854.     rock_characteristics:-cc(1,20,0),
  855.           print('THE MENU FOR A MINERAL CHARACTERISTICS'),
  856.           cc(7,20,0),
  857.           print('Enter the name of the mineral '),
  858.           read(Mineral1),check_mineral(Mineral1,Mineral),mineral(Mineral).
  859.